home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-03
/
imb9101.zip
/
GETFILEN.BAS
< prev
next >
Wrap
BASIC Source File
|
1990-12-31
|
2KB
|
66 lines
'Program - - GETFILEN.BAS
DECLARE FUNCTION ProgramName$ ()
DEFINT A-Z
CONST FALSE = 0
CONST TRUE = -1
'PDS users should change the next line to include the QBX.BI file
'$INCLUDE: 'QB.BI'
CLS
PRINT "Program name = "; ProgramName$
END
'=================== Function ProgramName$ ======================
'== INPUT: None ==
'== RETURNS: Name of currently executing program ==
'================================================================
'
FUNCTION ProgramName$
DIM Regs AS RegType
'Get PSP address
Regs.ax = &H6200
CALL Interrupt(&H21, Regs, Regs)
PSPSegment = Regs.bx
'Find environment address from PSP
DEF SEG = PSPSegment
EnvSegment = PEEK(&H2D) * 256 + PEEK(&H2C)
'Find the filename
DEF SEG = EnvSegment
EOT = FALSE 'Set end of environment table flag
Offset = 0
WHILE NOT EOT
Byte = PEEK(Offset) 'Get table character
IF Byte = 0 THEN 'End of environment string?
' PRINT 'Uncomment to print environment
Offset = Offset + 1
Byte = PEEK(Offset)
IF Byte = 0 THEN 'End of environment?
Offset = Offset + 3 'Yes - Skip over nulls & tbl info
C% = PEEK(Offset)
WHILE C% <> 0 'Assemble filename string
FileN$ = FileN$ + CHR$(C%) ' from individual
Offset = Offset + 1 ' characters
C% = PEEK(Offset)
WEND
EOT = TRUE 'Set flag to exit while/wend loop
END IF
ELSE 'No-Read more environment string
' PRINT CHR$(Byte); 'Uncomment to print environment
Offset = Offset + 1
END IF
WEND
ProgramName$ = FileN$
DEF SEG
END FUNCTION